Tech Arsenal 2

home *** CD-ROM | disk | FTP | other *** search

/ Tech Arsenal 2 / Tech Arsenal 2 (Arsenal Computer).iso / clipper / s93bsp.exe / CL5 / BODY00.PRG < prev next >

Wrap

Text File | 1993-11-26 | 15.6 KB | 785 lines

/////////////////////////////////////////////////////////////// // // Module : BODY00.PRG // // Created by SUMMER'93 (c) on Fri Nov 26 14:51:25 1993 // /////////////////////////////////////////////////////////////// #include "snj.ch" // The following statics were declared 'PUBLIC' in the S87 code // OR were private and inherited by called functions // If they are used outside this module there will be a set/get // function with the same name as the var in this module static MINVNO, MSPEEDO, MFUEL, MPARTDISC, MVATRATE, MOWNNAME, MOWNADD1; , MOWNADD2, MOWNADD3, MMAKEMODEL, MINSCO, MINSADD1, MINSADD2, MINSENG, MINSTEL; , MPAINT, MOWNTELH, MOWNTELB, MOWNVAT, MINSTOPAY, MACTYPE, MWORKTYPE, MDATEIN; , MDATEOUT, MDATEINV, MREGNO, MYEAR, MENGNO, MCHASNO, MESTNO, MLABESTNO; , MCLAIMNO, MLABOUR1, MLABOUR2, MLABOUR3, MLABOUR4, MLABOURT, MINSLAB, MOWNLAB; , MINSPART, MOWNPART, MINSSPEC, MOWNSPEC, MINSAMT, MOWNAMT, MEXCESS, MCONTRIB; , MINSDUE, MOWNDUE, MINVTOTAL, MCUSTTYP, ML2TEXT, ML3TEXT, ML4TEXT, MTRIM; , MPARTSPEC, MPARTDESC, MQTY, MTPRICE, MUPRICE, MOWNINIT, IPDSCNT, OPDSCNT; , ISUBTOT, OSUBTOT, IVATAMT, OVATAMT, INSSUB, OWNSUB, MCTYPE, MCDESC, MADD; , MPLINENO, MEDITING, AUTOADD, PARTFLDS [ 4 ], PARTHDRS [ 4 ], PARTPICS [ 4 ] // This procedure named after its module procedure BODY00 // Calls: BODYWORK // Called By: MAIN if pcount( )<> 0 altd( ) endif do BODYWORK // set procedure to CUSTYPFN additive // set procedure to HOUSE00 additive // set procedure to INV00 additive // set procedure to INV01 additive // set procedure to INVSCRN additive // set procedure to INVSLCT additive // set procedure to PARTFUNC additive // set procedure to QBDBFUNC additive // set procedure to QBIPROC additive // set procedure to QBPROCS additive // set procedure to QBTXTMAC additive // set procedure to REP00 additive quit function GOTOP // Calls: // Called By: go top return reccount( ) function QBSKIP( NSKIP ) // Amended by SUMMER93 // Calls: // Called By: skip NSKIP return recno( ) procedure BODYWORK // Calls: QBINIT BODYINIT QBLAYOUT QBBOX QBMENU QBYESNO INVMAIN REPMAIN HOUSEMAIN // Called By: BODY00 //** BODY00.PRG : Main menu. //** local MAINCH do QBINIT do BODYINIT do while .t. do QBLAYOUT with "Main menu" do QBBOX with 40 MAINCH := QBMENU( "MAIN", 30 ) do case case MAINCH = 0 .or. MAINCH = 4 if QBYESNO( "Do you really wish to Quit now?" ) = "Y" exit endif case MAINCH = 1 do INVMAIN case MAINCH = 2 do REPMAIN case MAINCH = 3 do HOUSEMAIN endcase QBCHOICE( MAINCH ) enddo close database clear screen ?? "Exit " + trim( QBTITLE() ) + " application" quit //****************************************************************** procedure BODYINIT // Calls: INVCLEAR PARTCLEAR // Called By: BODYWORK // B O D Y I N I T // INVOICE Information // public PARTFLDS[5], PARTHDRS[5], PARTPICS[5] INVCLEAR( ) PARTCLEAR( ) MCUSTTYP := space(4 ) MCDESC := space(35 ) MADD := MEDITING := AUTOADD := .f. PARTHDRS[ 1 ] := " Description" PARTFLDS[ 1 ] := "PARTDESC" PARTPICS[ 1 ] := replicate( "X", 15 ) PARTHDRS[ 2 ] := "Qty" PARTFLDS[ 2 ] := "QTY" PARTPICS[ 2 ] := "99" PARTHDRS[ 3 ] := " Unit P" PARTFLDS[ 3 ] := "UPRICE" PARTPICS[ 3 ] := "9999.99" PARTHDRS[ 4 ] := "Total P" PARTFLDS[ 4 ] := "TPRICE" PARTPICS[ 4 ] := "9999.99" //PARTHDRS[5] = "Part/Spec" //PARTFLDS[5] = "PARTSPEC" //PARTPICS[5] = "@R !" return //****************************************************************** function V2DATES( OTHERD, TESTYPE ) // Amended by SUMMER93 // Calls: // Called By: INVVEH // Vali DATE ha ha local RETVAL, MEM, VARNAME VARNAME := readvar() // SUMMER93 - Caution // A call to 'readvar' followed by a macro can // be replaced by use of 'getactive' and 'varget' // VARNAME := GETACTIVE():VARGET() MEM := &VARNAME if( empty(MEM ).or. empty(OTHERD )).and. TESTYPE > 0 return .t. else TESTYPE := abs( TESTYPE ) endif do case case TESTYPE = 1 RETVAL := ( MEM <= OTHERD ) case TESTYPE = 2 RETVAL := ( MEM >= OTHERD ) case TESTYPE = 3 RETVAL := ( MEM < OTHERD ) case TESTYPE = 4 RETVAL := ( MEM > OTHERD ) otherwise RETVAL := .t. endcase return RETVAL //**************************************************************** function PRPOS( NUM, PIC ) // Amended by SUMMER93 // Calls: // Called By: INVTOT local PLEN, RETVAL if NUM > 0 RETVAL := transform( NUM, PIC ) else RETVAL := space( len(PIC )) // RETVAL = replicate("#",len(PIC)) endif return RETVAL //************************************************************* function NEWNUM( PRMSG ) // Amended by SUMMER93 // Calls: QBMESS // Called By: INVADD INVREN INVNEW // Validate New Invoice number local SELNO, RETVAL, OLDSCR, MEM, VARNAME if pcount( ) = 0 PRMSG := .f. endif if PRMSG VARNAME := readvar() // SUMMER93 - Caution // A call to 'readvar' followed by a macro can // be replaced by use of 'getactive' and 'varget' // VARNAME := GETACTIVE():VARGET() MEM := &VARNAME else MEM := MINVNO endif SELNO := select( ) select INVOICE set index to INVNUM set softseek off seek str( MEM, 5 ) RETVAL := eof( ).and. MEM > 0 if( !RETVAL ).and. PRMSG OLDSCR := savescreen( 0, 0, 1, 79 ) do QBMESS with "Invoice already exists", COLFLASH() , 3 restscreen( 0, 0, 1, 79, OLDSCR ) endif select( SELNO ) return RETVAL FUNCTION MINVNO( xNewVal ) local xReturn := MINVNO if xNewVal <> NIL MINVNO := xNewVal endif return xReturn FUNCTION MSPEEDO( xNewVal ) local xReturn := MSPEEDO if xNewVal <> NIL MSPEEDO := xNewVal endif return xReturn FUNCTION MFUEL( xNewVal ) local xReturn := MFUEL if xNewVal <> NIL MFUEL := xNewVal endif return xReturn FUNCTION MPARTDISC( xNewVal ) local xReturn := MPARTDISC if xNewVal <> NIL MPARTDISC := xNewVal endif return xReturn FUNCTION MVATRATE( xNewVal ) local xReturn := MVATRATE if xNewVal <> NIL MVATRATE := xNewVal endif return xReturn FUNCTION MOWNNAME( xNewVal ) local xReturn := MOWNNAME if xNewVal <> NIL MOWNNAME := xNewVal endif return xReturn FUNCTION MOWNADD1( xNewVal ) local xReturn := MOWNADD1 if xNewVal <> NIL MOWNADD1 := xNewVal endif return xReturn FUNCTION MOWNADD2( xNewVal ) local xReturn := MOWNADD2 if xNewVal <> NIL MOWNADD2 := xNewVal endif return xReturn FUNCTION MOWNADD3( xNewVal ) local xReturn := MOWNADD3 if xNewVal <> NIL MOWNADD3 := xNewVal endif return xReturn FUNCTION MMAKEMODEL( xNewVal ) local xReturn := MMAKEMODEL if xNewVal <> NIL MMAKEMODEL := xNewVal endif return xReturn FUNCTION MINSCO( xNewVal ) local xReturn := MINSCO if xNewVal <> NIL MINSCO := xNewVal endif return xReturn FUNCTION MINSADD1( xNewVal ) local xReturn := MINSADD1 if xNewVal <> NIL MINSADD1 := xNewVal endif return xReturn FUNCTION MINSADD2( xNewVal ) local xReturn := MINSADD2 if xNewVal <> NIL MINSADD2 := xNewVal endif return xReturn FUNCTION MINSENG( xNewVal ) local xReturn := MINSENG if xNewVal <> NIL MINSENG := xNewVal endif return xReturn FUNCTION MINSTEL( xNewVal ) local xReturn := MINSTEL if xNewVal <> NIL MINSTEL := xNewVal endif return xReturn FUNCTION MPAINT( xNewVal ) local xReturn := MPAINT if xNewVal <> NIL MPAINT := xNewVal endif return xReturn FUNCTION MOWNTELH( xNewVal ) local xReturn := MOWNTELH if xNewVal <> NIL MOWNTELH := xNewVal endif return xReturn FUNCTION MOWNTELB( xNewVal ) local xReturn := MOWNTELB if xNewVal <> NIL MOWNTELB := xNewVal endif return xReturn FUNCTION MOWNVAT( xNewVal ) local xReturn := MOWNVAT if xNewVal <> NIL MOWNVAT := xNewVal endif return xReturn FUNCTION MINSTOPAY( xNewVal ) local xReturn := MINSTOPAY if xNewVal <> NIL MINSTOPAY := xNewVal endif return xReturn FUNCTION MACTYPE( xNewVal ) local xReturn := MACTYPE if xNewVal <> NIL MACTYPE := xNewVal endif return xReturn FUNCTION MWORKTYPE( xNewVal ) local xReturn := MWORKTYPE if xNewVal <> NIL MWORKTYPE := xNewVal endif return xReturn FUNCTION MDATEIN( xNewVal ) local xReturn := MDATEIN if xNewVal <> NIL MDATEIN := xNewVal endif return xReturn FUNCTION MDATEOUT( xNewVal ) local xReturn := MDATEOUT if xNewVal <> NIL MDATEOUT := xNewVal endif return xReturn FUNCTION MDATEINV( xNewVal ) local xReturn := MDATEINV if xNewVal <> NIL MDATEINV := xNewVal endif return xReturn FUNCTION MREGNO( xNewVal ) local xReturn := MREGNO if xNewVal <> NIL MREGNO := xNewVal endif return xReturn FUNCTION MYEAR( xNewVal ) local xReturn := MYEAR if xNewVal <> NIL MYEAR := xNewVal endif return xReturn FUNCTION MENGNO( xNewVal ) local xReturn := MENGNO if xNewVal <> NIL MENGNO := xNewVal endif return xReturn FUNCTION MCHASNO( xNewVal ) local xReturn := MCHASNO if xNewVal <> NIL MCHASNO := xNewVal endif return xReturn FUNCTION MESTNO( xNewVal ) local xReturn := MESTNO if xNewVal <> NIL MESTNO := xNewVal endif return xReturn FUNCTION MLABESTNO( xNewVal ) local xReturn := MLABESTNO if xNewVal <> NIL MLABESTNO := xNewVal endif return xReturn FUNCTION MCLAIMNO( xNewVal ) local xReturn := MCLAIMNO if xNewVal <> NIL MCLAIMNO := xNewVal endif return xReturn FUNCTION MLABOUR1( xNewVal ) local xReturn := MLABOUR1 if xNewVal <> NIL MLABOUR1 := xNewVal endif return xReturn FUNCTION MLABOUR2( xNewVal ) local xReturn := MLABOUR2 if xNewVal <> NIL MLABOUR2 := xNewVal endif return xReturn FUNCTION MLABOUR3( xNewVal ) local xReturn := MLABOUR3 if xNewVal <> NIL MLABOUR3 := xNewVal endif return xReturn FUNCTION MLABOUR4( xNewVal ) local xReturn := MLABOUR4 if xNewVal <> NIL MLABOUR4 := xNewVal endif return xReturn FUNCTION MLABOURT( xNewVal ) local xReturn := MLABOURT if xNewVal <> NIL MLABOURT := xNewVal endif return xReturn FUNCTION MINSLAB( xNewVal ) local xReturn := MINSLAB if xNewVal <> NIL MINSLAB := xNewVal endif return xReturn FUNCTION MOWNLAB( xNewVal ) local xReturn := MOWNLAB if xNewVal <> NIL MOWNLAB := xNewVal endif return xReturn FUNCTION MINSPART( xNewVal ) local xReturn := MINSPART if xNewVal <> NIL MINSPART := xNewVal endif return xReturn FUNCTION MOWNPART( xNewVal ) local xReturn := MOWNPART if xNewVal <> NIL MOWNPART := xNewVal endif return xReturn FUNCTION MINSSPEC( xNewVal ) local xReturn := MINSSPEC if xNewVal <> NIL MINSSPEC := xNewVal endif return xReturn FUNCTION MOWNSPEC( xNewVal ) local xReturn := MOWNSPEC if xNewVal <> NIL MOWNSPEC := xNewVal endif return xReturn FUNCTION MINSAMT( xNewVal ) local xReturn := MINSAMT if xNewVal <> NIL MINSAMT := xNewVal endif return xReturn FUNCTION MOWNAMT( xNewVal ) local xReturn := MOWNAMT if xNewVal <> NIL MOWNAMT := xNewVal endif return xReturn FUNCTION MEXCESS( xNewVal ) local xReturn := MEXCESS if xNewVal <> NIL MEXCESS := xNewVal endif return xReturn FUNCTION MCONTRIB( xNewVal ) local xReturn := MCONTRIB if xNewVal <> NIL MCONTRIB := xNewVal endif return xReturn FUNCTION MINSDUE( xNewVal ) local xReturn := MINSDUE if xNewVal <> NIL MINSDUE := xNewVal endif return xReturn FUNCTION MOWNDUE( xNewVal ) local xReturn := MOWNDUE if xNewVal <> NIL MOWNDUE := xNewVal endif return xReturn FUNCTION MINVTOTAL( xNewVal ) local xReturn := MINVTOTAL if xNewVal <> NIL MINVTOTAL := xNewVal endif return xReturn FUNCTION MCUSTTYP( xNewVal ) local xReturn := MCUSTTYP if xNewVal <> NIL MCUSTTYP := xNewVal endif return xReturn FUNCTION ML2TEXT( xNewVal ) local xReturn := ML2TEXT if xNewVal <> NIL ML2TEXT := xNewVal endif return xReturn FUNCTION ML3TEXT( xNewVal ) local xReturn := ML3TEXT if xNewVal <> NIL ML3TEXT := xNewVal endif return xReturn FUNCTION ML4TEXT( xNewVal ) local xReturn := ML4TEXT if xNewVal <> NIL ML4TEXT := xNewVal endif return xReturn FUNCTION MTRIM( xNewVal ) local xReturn := MTRIM if xNewVal <> NIL MTRIM := xNewVal endif return xReturn FUNCTION MPARTSPEC( xNewVal ) local xReturn := MPARTSPEC if xNewVal <> NIL MPARTSPEC := xNewVal endif return xReturn FUNCTION MPARTDESC( xNewVal ) local xReturn := MPARTDESC if xNewVal <> NIL MPARTDESC := xNewVal endif return xReturn FUNCTION MQTY( xNewVal ) local xReturn := MQTY if xNewVal <> NIL MQTY := xNewVal endif return xReturn FUNCTION MTPRICE( xNewVal ) local xReturn := MTPRICE if xNewVal <> NIL MTPRICE := xNewVal endif return xReturn FUNCTION MUPRICE( xNewVal ) local xReturn := MUPRICE if xNewVal <> NIL MUPRICE := xNewVal endif return xReturn FUNCTION MOWNINIT( xNewVal ) local xReturn := MOWNINIT if xNewVal <> NIL MOWNINIT := xNewVal endif return xReturn FUNCTION IPDSCNT( xNewVal ) local xReturn := IPDSCNT if xNewVal <> NIL IPDSCNT := xNewVal endif return xReturn FUNCTION OPDSCNT( xNewVal ) local xReturn := OPDSCNT if xNewVal <> NIL OPDSCNT := xNewVal endif return xReturn FUNCTION ISUBTOT( xNewVal ) local xReturn := ISUBTOT if xNewVal <> NIL ISUBTOT := xNewVal endif return xReturn FUNCTION OSUBTOT( xNewVal ) local xReturn := OSUBTOT if xNewVal <> NIL OSUBTOT := xNewVal endif return xReturn FUNCTION IVATAMT( xNewVal ) local xReturn := IVATAMT if xNewVal <> NIL IVATAMT := xNewVal endif return xReturn FUNCTION OVATAMT( xNewVal ) local xReturn := OVATAMT if xNewVal <> NIL OVATAMT := xNewVal endif return xReturn FUNCTION INSSUB( xNewVal ) local xReturn := INSSUB if xNewVal <> NIL INSSUB := xNewVal endif return xReturn FUNCTION OWNSUB( xNewVal ) local xReturn := OWNSUB if xNewVal <> NIL OWNSUB := xNewVal endif return xReturn FUNCTION MCDESC( xNewVal ) local xReturn := MCDESC if xNewVal <> NIL MCDESC := xNewVal endif return xReturn FUNCTION MADD( xNewVal ) local xReturn := MADD if xNewVal <> NIL MADD := xNewVal endif return xReturn FUNCTION MPLINENO( xNewVal ) local xReturn := MPLINENO if xNewVal <> NIL MPLINENO := xNewVal endif return xReturn FUNCTION MEDITING( xNewVal ) local xReturn := MEDITING if xNewVal <> NIL MEDITING := xNewVal endif return xReturn FUNCTION AUTOADD( xNewVal ) local xReturn := AUTOADD if xNewVal <> NIL AUTOADD := xNewVal endif return xReturn FUNCTION PARTFLDS( xIndex, xParam ) local xOldVal if xIndex == NIL xOldVal := PARTFLDS elseif valtype( xIndex ) == "A" xOldVal := PARTFLDS PARTFLDS := xIndex elseif valtype( xIndex ) == "N" xOldVal := PARTFLDS[ xIndex ] if xParam != NIL PARTFLDS[ xIndex ] := xParam endif endif return xOldVal FUNCTION PARTHDRS( xIndex, xParam ) local xOldVal if xIndex == NIL xOldVal := PARTHDRS elseif valtype( xIndex ) == "A" xOldVal := PARTHDRS PARTHDRS := xIndex elseif valtype( xIndex ) == "N" xOldVal := PARTHDRS[ xIndex ] if xParam != NIL PARTHDRS[ xIndex ] := xParam endif endif return xOldVal FUNCTION PARTPICS( xIndex, xParam ) local xOldVal if xIndex == NIL xOldVal := PARTPICS elseif valtype( xIndex ) == "A" xOldVal := PARTPICS PARTPICS := xIndex elseif valtype( xIndex ) == "N" xOldVal := PARTPICS[ xIndex ] if xParam != NIL PARTPICS[ xIndex ] := xParam endif endif return xOldVal // End of file